perm filename MSS.F4[MSS,LCS]1 blob sn#091409 filedate 1974-03-19 generic text, type T, neo UTF8
00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600		COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ(20)
00700		DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(7),R(8,100)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000		COMMON/ALF/INP(72),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO	
01400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600		1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2)),(IT,LY(7))
01700		1,(RJC,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(RXGP,WDS(250))
01800		1,(RJK,RJQ(9)),(RJQJ,RJQ(8)),(SET4,RN(3920)),(R,RN(3001))
01900		1 ,(TOP,ST(3999)),(BOT,ST(4000)),(RJH,RJQ(6)),(RJI,RJQ(7))
02000		1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(RJM,RJQ(11))
02100		1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02200		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02300		1 ,LST/'NOTE','REST','CLEF','LINE','NUMB',
02400		1 'MISC','KSIG','SLUR','BEAM','STAFF','METER','TRILL','WORD'/
02500		1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02600		1 'S','U','X'/
02700		1,LY/' ','A','B','D','E','F','T'/
02800	
02900		TOP2=-999
03000		RXGP=0
03100		I1=0
03200	C  RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
03300	2	CALL DPYSET(1,ST,4000)
03400		CALL TYPLOC(-200,-511)
03500		CALL DPYBRT(5)
03600		RPOS(1,1)=0
03700		PLOTIT=0
03800		RSZ=.845
03900		TOP=-999
04000		BOT=999
04100		JSTF=-1
04200		X22=0
04300		JCEN=0
04400		KCEN=0
04500		PLT=0
04600		PWDS(1)=1.
04700		EDX=-1
04800		SAVER=7
04900		DO 1402 K=1,8
05000	1402	RSTFAC(K)=1.
05100		REDIT=999.
05200		M=1
05300		ITEM=0
05400		ZERO=-1
05500		WDS(1)=4
05600	C  DATA IN DPY ARRAY STARTS AT WD.4!
05700		I=1
05800	1100	SCORE=-1
05900	1000	IREADX=0
06000		KNT=0
06100		CALL DPYOUT(1)
06200		IF(SCORE.OR.REND)GO TO 58
06300	C   REND=-1 LAST TIME IN SCORE SECTION
06400		CALL SCMSS
06500		I=ISC
06600		ITEM=ISITEM
06700		ST2=WDS(ITEM+1)
06800		CALL ACCPOG(1)
06900		IF(REND.NE.100)GO TO 553
07000	C   FOR ESCAPE FROM 'SCORE' SECTION
07100		GO TO 1100
07200	58	GO=-1
07300		GO TO 5505
07400	
07500	
07600	11	CALL NOTWRT
07700	57	IF(PLT)GO TO 6120
07800		IF(M.LE.I.AND.GO)CALL DPYOUT(1)
07900		IF(JA.EQ.101)GO TO 5531
08000		ITEM=ITEM+1
08100		IF(GO.GT.0)GO TO 20000
08200		K=ST2
08300		IF(X22.EQ.0)GO TO 20000
08400		CALL BOX(IBOX,RBOX,STFF)
08500		ST2=K
08600	20000	WDS(ITEM+1)=ST2
08700		IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08800		IF(PLOTIT.EQ.-2)GO TO 2311
08900	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
09000		PWDS(ITEM+1)=I
09100		PLT=0
09200		IF(GO.NE.0)GO TO 5531
09300		CALL DPYOUT(1)
09400		GO=-1
09500	
09600	5531	IF(IREADX.EQ.-2)GO TO 653
09700		IF(JSTF)GO TO 55
09800		JA=JSTF
09900		JSTF=-1
10000		GO TO 889
10100	C PUT IN A STAFF
10200	55	IF(IREADX.OR.SCORE.EQ.0)GO TO 553
10300	5505	SVST=ST2
10400	C CATCHES TYPO WITH 'C'
10500		K=ITEM+1
10600		IF(X22.EQ.0)GO TO 5503
10700		K=X22
10800		L=RN(MEDIT+1)
10900		IF(L.EQ.16)L=13
11000		IF(L.EQ.18)L=11
11100		IF(L.EQ.30)L=12
11200		IF(L.EQ.11)L=0
11300	C  CHANGE CODE NUMS FOR 18 AND 30 ****************
11400		TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11500		IF(YED.LT.2)GO TO 5500
11600	C   YED IS SET AT 426
11700	5502	DO 5501 L=4,YED+2
11800	5501	TYPE 4271,L,RN(MEDIT+L)
11900		GO TO 5500
12000	891	DEL=0
12100	C   THIS NOT USED IF DEL=0 AT LN32510 ***********
12200		GO TO 6531
12300	
12400	5503	CALL HYDPOG(3)
12500	C  TO DELETE VERTICAL LINE (55)
12600		KED=0
12700	5500	IF(DEL)GO TO 891
12800		IF(IREADX)GO TO 653
12900	5504	IF(I1.EQ.IP)GO TO 2311
13000	59	TYPE 56,NAME,K,SVST
13100		JAB=JA
13200		SCORE=-1
13300		ACCEPT 89,INP
13400		DO 1313 LKX=1,14
13500	1313	IF(I1.EQ.LX(LKX))GO TO 2313
13600		LKX=0
13700	2313	LKX=LKX+1
13800	C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
13900		IF(X22.NE.0)GO TO(87,884,883,883,5313,87,884,87,883,87,59,883
14000		1,15,883,883),LKX
14100		GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
14200		1,59),LKX
14300	C                  A   C   D   E   G   I  J   L   M     P   R   S U(X
14400	C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
14500	C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
14600	14	IF(I2-IE)883,13,884
14700	13	GO=1
14800		CALL GRED
14900		IF(JA.EQ.98)GO TO 5533
15000		KNT=0
15100		SCORE=0
15200		GO TO 65
15300	15	DO 3313 LKY=1,7
15400	3313	IF(I2.EQ.LY(LKY))GO TO(312,3121,3121,3121,312,115,884),LKY
15500	C                               BL  A    B     D    E   F   T
15600	C  'SF'= SAVE AND FIXUP (I HOPE THIS IS TEMPORARY)
15700	115	CALL FIXUP
15800		GO TO 5505
15900	C  RESETS FACTORS FOR SAVE AND REDISPLAY
16000	3121	IF(X22.NE.0)GO TO 5505
16100		SAVER=7
16200		CALL SAVIT
16300		GO TO 5505
16400	312	JA=55
16500		RJB=RN(MEDIT+2)
16600		RJC=55.
16700		GO TO 6531
16800	C  ABOVE FOR 'S'ET ALIGNMENT
16900	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
17000	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;  'P' #S = PLOT IT
17100	5313	K=-1
17200		DO 882 JA=3,10
17300	882	IF(INP(JA).NE.IBL)GO TO 884
17400		GO TO 883
17500	885	FORMAT(A2,21F)
17600	884	REREAD 885,K,RJB,RJQ
17700		JA=55
17800		IF(I1.EQ.II)JA=22
17900		IF(I2.EQ.IT)JA=44
18000		IF(I2.NE.'P')GO TO 6531
18100		IF(RJB.GT.5)GO TO 1886
18200	C  GO BACK AND RESET ALL
18300		K=RJB
18400		JA=0
18500	C  USE '5' FOR STAFF 0.
18600	888	IF(K.EQ.5)K=0
18700		DP(K)=-DP(K)
18800		JA=JA+1
18900		K=RJQ(JA)
19000		IF(K.EQ.0)GO TO 85
19100	C  JUMP OUT IF RJQ(JA)=0
19200		GO TO 888
19300	C  TO GET BACK ALL LINES TYPE 6+
19400	311	JA=0
19500		ML=0
19600		IF(I2.NE.'X')GO TO 884
19700	1886	DO 2886 K=-3,4
19800	2886	DP(K)=1
19900		IF(I1.NE.IP)GO TO 8851
20000	C PXG OR PXC RESETS 'DP'
20100	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
20200	2311	CALL PLTCMD
20300		IF(PLOTIT.EQ.0)GO TO 3005
20400		I1=IP
20500		PLOTIT=-1
20600		GO TO 6531
20700	C  'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
20800	
20900	881	IF(I1.GT.0)GO TO 87
21000	C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
21100	883	IF(I2.EQ.IS)GO TO 2
21200	C  TYPE 'RS' TO RESTART.
21300		IF(IX.EQ.I.AND.I1.EQ.'C')GO TO 72
21400		CALL EDIT(JJA,RJJB)
21500		GO TO 6531
21600	89	FORMAT(72A1)
21700	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
21800	
21900	87	REREAD 1,JA,RJB,RJQ
22000		IF(K)JA=55
22100	C   ED 47 -1 = 55 47 -1, ETC.
22200		IF(JA.EQ.101)GO TO 11
22300		IF(JA.GT.0)SAVER=SAVER-1
22400		IF(SAVER.AND.X22.EQ.0)CALL SAVIT
22500	C  SAVES EVERY 7TH TIME AROUND
22600		IF(JA.EQ.14.OR.JA.EQ.16.OR.JA.EQ.144)GO TO 88
22700		GO TO 6531
22800	188	RJB=0
22900	88	RSTJC=RSTFAC(JC+4)
23000		SET4=RJB
23100	C  SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
23200		IF(JA.NE.14)GO TO 889
23300	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
23400		SAVER=-1
23500		DO 1889 K=1,I
23600		J=PWDS(K)
23700		IF(RN(J+1).NE.10)GO TO 1889
23800		IF(RN(J+3).EQ.RJC)GO TO 889
23900	1889	CONTINUE
24000	C DIDN'T FIND THIS STAFF
24100		JSTF=JA
24200		JA=10
24300		GO TO 6531
24400	889	SCORE=0
24500		ISC=I
24600		ISITEM=ITEM
24700	C   RETAINS ORIGINS OF SCORE SQUENCE
24800	CC	DO 9532 K=1,8
24900		DO 9532 L=3001,3800
25000	9532	RN(L)=0
25100	C  CLEARS R( , ) ARRAY
25200		REND=0
25300		RSTF=RJC
25400		R(1,1)=JA
25500		R(2,1)=RJB
25600		R(3,1)=RJD
25700		R(4,1)=RJE
25800		R(5,1)=RJF
25900		KNT=0
26000	9533	CALL SCMSS
26100		IREADX=-1
26200		IF(REND)GO TO 653
26300	553	IF(SCORE)GO TO 6531
26400	65	GO=1
26500	C  SO DPYOUT COMES ONLY ONE PER LINE.
26600	653	KNT=KNT+1
26700	C   NUM OF ITEMS IN LIST
26800		RJK=0
26900		RJQJ=0
27000		RJI=0
27100		JA=R(1,KNT)
27200		RJB=R(2,KNT)
27300		IF(JA.NE.100)GO TO 550
27400		IF(REND.NE.1.)GO TO 1000
27500	C   =1 GOES BACK FOR MORE
27600		KNT=0
27700		IF(RJB.LT.0)GO TO 188
27800	C  WILL READ ANOTHER STAFF
27900		GO TO 1100
28000	C  100 STOPS READER.
28100	550	DO 7531 K=1,6
28200	7531	RJQ(K)=R(K+2,KNT)
28300		IF(RJG.EQ.1.9)RJQJ=1
28400	C  FOR GRACE NOTE SLASH
28500	CC	RJI=AMOD(RJC,1.)
28600		IF(JA.EQ.9)GO TO 16
28700		IF(JA.NE.999)GO TO 6531
28800	C  999 MEANS P9 AND P10 ARE USED WITH BEAMS
28900		JA=9
29000		RJQ(8)=R(3,KNT)
29100		RJI=R(2,KNT)
29200		RJB=RJJB
29300		RJC=RJJ(1)
29400	16	RJK=-1
29500	6531	M=1
29600		EDX=-1
29700		IF(JA.EQ.222)GO TO 72
29800		IF(JA.EQ.2222)GO TO 73
29900		DO 5532 K=1,10
30000	5532	JQ(K)=RJQ(K)
30100		IF(JA.NE.99.AND.JA.NE.98)GO TO 7542
30200		CALL DELETE
30300		IF(JA.EQ.99)GO TO 425
30400	5533	X22=0
30500		GO=-1
30600		CALL DPYNEW
30700		GO TO 55
30800	
30900	590	IF(PLOTIT.EQ.-1)GO TO 121
31000		I1=0
31100		GO TO 243
31200	C  GOES TO PLOTTER
31300	7542	IF(I1.EQ.'P')GO TO 590
31400	C  X22= ITEM# WHEN EDITING OR DELETING.
31500		IF(X22.NE.0)GO TO 5511
31600		IF(JA.GT.0)GO TO 155
31700		IF(RJB.NE.0)GO TO 6221
31800	C  FOR UP, DOWN, LEFT, RIGHT
31900		GO TO 5505
32000	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
32100	155	IF(JA.EQ.24)GO TO 24
32200		IF(JA.EQ.22)GO TO 42  
32300		IF(JA.EQ.44)GO TO 44
32400		IF(JA.EQ.55)GO TO 554
32500		IF(JA.EQ.333)GO TO 6333
32600		IF(IABS(JC).GT.5.OR.(IABS(JD).GT.50.AND.JA.GT.4.AND.
32700		1 JA.NE.9.AND.JA.NE.10))GO TO 5505
32800	C  CATCHES SOME TYPO ERRORS IN P3 AND P4.
32900	C  AVOIDS EXIT AFTER TYPO ERROR
33000		IF(JA.EQ.21.OR.JA.EQ.19)GO TO 61
33100		GO TO 60
33200	
33300	33	JB=RJB
33400		RJB=RJJ(JB-2)
33500		IF(JB.EQ.2)RJB=RJJB
33600		TYPE 1,JB,RJB
33700	C  TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
33800		GO TO 5505
33900	
34000	24	GO=0
34100		IF(ABS(RJB).GT.99)GO TO 5505
34200		IF(RJB.NE.0)GO TO 241
34300		GO=-1
34400	243	RJB=1.
34500	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
34600	241	RSZ=.845*RJB
34700		JCEN=RJC*RSZ
34800		KCEN=RJD*RSZ
34900		RJB=0
35000		RJC=0
35100		RJD=0
35200		TOP=-999
35300		BOT=999
35400	85	M=1
35500		I=PWDS(ITEM+1)
35600		ITEM=0
35700	8552	ST2=3
35800	8852	PLT=1
35900		EDX=0
36000		CALL ACCPOG(1)
36100		IF(JA.NE.24)GO=0
36200		GO TO 6120
36300	
36400	6333	CALL LISTP(LST)
36500		GO TO 5505
36600	
36700	172	CALL JUGGLE
36800	272	CALL DPYNEW
36900		IF(JA.EQ.22)GO TO 424
37000	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
37100		IF(ZERO)GO TO 55
37200		X22=ZERO
37300		ZERO=-1
37400		IF(JA.EQ.55)GO TO 554
37500		IF(JA.EQ.44)GO TO 44
37600		IF(KED.NE.0)GO TO 244
37700		GO TO 425
37800	
37900	C  55,POS  -- SETS UP ALIGNMENT
38000	554	CALL BOX(-1,RJB,STFF)
38100		IF(JD.EQ.0)KED=-1
38200		RITEM=RJD
38300	C  FOR 'ED POS., STF., CODE#'
38400		IF(JC.GT.4)KED=-2
38500		RLINE=RJB
38600		RJB=RJC
38700		GO TO 45
38800	
38900	C  '22,0' EDITS LAST ITEM ENTERED
38950	42	REDIT=999.0
39000		IF(RJB.NE.0)GO TO 242
39100		X22=ITEM
39200		GO TO 429
39300	44	KED=1	
39400		RITEM=RJC
39500	C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP)
39600	45	REDIT=RJB
39700	C  THE STAFF #
39800		JED=1
39900	244	X=ITEM  
40000		IF(JED.GT.X)GO TO 444
40100		DO 144 K=JED,X
40200		L=PWDS(K)
40300		IF(KED.EQ.-2)GO TO 654
40400	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
40500		IF(RN(L+3).NE.REDIT)GO TO 144
40600		IF(KED)GO TO 654
40700		IF(RITEM.NE.0.AND.RITEM.NE.RN(L+1))GO TO 144
40800		IF(JA.NE.55)GO TO 344
40900	654	IF(ABS(RLINE-RN(L+2)).LT.5.0)GO TO 344
41000	144	CONTINUE
41100	444	REDIT=999.
41200	C  NO MORE ON LINE
41300		RJB=0
41400	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
41500		GO TO 73
41600	344	JED=K+1
41700	C  FOR NEXT TIME AROUND
41800		X22=K
41900		GO TO 429
42000	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
42100	
42200	91	CALL ACCPOG(1)
42300		IF(I.EQ.IX)ITEM=ITEM-1
42400		GO TO 142
42500	242	IF(X22.GT.0)GO TO 5511
42600	142	IF(RJB.NE.0)GO TO 424
42700		IF(REDIT.NE.999..AND.JA.GE.0)GO TO 244
42800		X22=X22+1
42900		IF(JA)X22=X22-1+JA
43000		IF(X22.LT.1)X22=1
43100		GO TO 425
43200	424	X22=RJB
43300	425	IF(X22.GT.ITEM)GO TO 73
43400	C  LEAVES EDIT MODE.
43500	429	IX=I
43600		MEDIT=PWDS(X22)
43700		J=2
43800	426	Y=RN(MEDIT)+J
43900		CALL LOOP(0,Y,1,I,MEDIT,RN)
44000		JJA=RN(I+1)
44100		YED=Y-2
44200		L=I+2
44300		DO 422 K=1,11
44400		IF(K.GT.YED)GO TO 423
44500		RJJ(K)=RN(L+K)
44600		GO TO 422
44700	423	RJJ(K)=0
44800	422	CONTINUE
44900		RJJB=RN(L)
45000		IF(GO.GT.0)GO TO 4231
45100	C  NO BOX WHEN IN GROUP EDIT ROUTINE
45200		IBOX=I
45300		RBOX=RJJ(1)
45400		CALL BOX(IBOX,RBOX,STFF)
45500	4231	ITEM=ITEM+1
45600		ST2=WDS(ITEM)
45700		GO TO 55
45800	427	FORMAT(1XA5/,F4.0,F7.2,F6.2,$)
45900	4271	FORMAT('+  (',I2,')',F7.2,$)
46000	
46100	C  FOR EDITING
46200	5511	IF(JA.EQ.55)GO TO 420
46300	220	IF(JA.NE.22)GO TO 720
46400	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
46500		KED=0
46600		JED=0
46700		GO TO 72
46800	720	IF(JA.EQ.44)GO TO 420
46900		IF(JA.EQ.33)GO TO 33
47000		IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
47100	C  PARAM NUM TOO HIGH?
47200	C  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
47300	4221	IF(X22.EQ.0.OR.RJB.NE.0)GO TO 5517
47400	C  BACKS UP WHEN IN EDIT MODE.
47500	
47600		IF(JA.GT.0)GO TO 5518
47700		IF(I.EQ.IX)GO TO 91
47800		ZERO=X22+1
47900	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
48000	72	IF(X22.EQ.0)GO TO 55
48100		IF(KED.EQ.0)REDIT=999.
48200	320	IF(I.NE.IX)GO TO 172
48300		ITEM=ITEM-1
48400	C  TO DELETE AN ITEM
48500	73	X22=0 
48600		CALL DPYNEW
48700		IF(REDIT.EQ.999.)GO TO 441
48800		IF(JA.EQ.55)GO TO 554
48900		IF(JA.EQ.44)GO TO 44
49000	441	IF(RJB.EQ.0.OR.RJB.GT.ITEM)GO TO 55
49100		GO TO 424
49200	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
49300	
49400	5517	IF(JA.EQ.0)GO TO 6221
49500	5518	IF(JA.EQ.2)GO TO 7221
49600		IF(JA.GE.22)GO TO 55
49700		RJJ(JA-2)=RJB
49800		RJB=RJJB
49900		GO TO 6222
50000	
50100	7555	CALL MOVER
50200		IF(RJC.EQ.99)GO TO 5504
50300	C   99=BACKUP OUT OF MOVER ETC.
50400	8853	IF(JJB)GO TO 57
50500		M=PWDS(JJB)
50600		I=PWDS(ITEM+1)
50700		ITEM=JJB-1
50800		ST2=WDS(JJB)
50900	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
51000		GO TO 8852
51100	
51200	8851	IF(I1.NE.IP)GO TO 85
51300		GO TO 6531
51400	
51500	420	REDIT=0
51600	211	IF(RJB.NE.0)GO TO 320
51700		IF(KED.GE.0)RLINE=RJJB
51800		RJB=RLINE
51900	C  FOR '55' ALIGNING
52000	7221	RJJB=RJB
52100	6222	IF(JQ(1).EQ.0)GO TO 6221
52200	C  ARRAYS NEED 2O LOCATIONS HERE.
52300	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
52400		DO 1222 K=1,20,2
52500		L=JQ(K)
52600		IF(L-2)6221,2222,3222
52700	3222	RJJ(L-2)=RJQ(K+1)
52800		GO TO 1222
52900	2222	RJJB=RJQ(K+1)
53000		RJB=RJJB
53100	1222	CONTINUE
53200	C***  LOOP SET TO 10 (20 IN ARRAY!)
53300	6221	DO 5514 K=1,11
53400		RJQ(K)=RJJ(K)
53500	5514	JQ(K)=RJQ(K)
53600		JA=JJA
53700		ITEM=ITEM-1
53800		IF(ITEM)ITEM=0
53900		ST2=WDS(ITEM+1)
54000		I=PWDS(ITEM+1)
54100		CALL DPYNEW
54200	
54300	60	IF(DP(JC))GO TO 57
54400		RSTJC=RSTFAC(JC+4)
54500		RD=0
54600		IF(JA.EQ.50)JA=16
54700	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
54800		IF(RJB.LT.1000)GO TO 66
54900		RD=RJB
55000		IF(JA.EQ.8)RJM=RJB/1000.
55100		CALL RNOTE(RJB)
55200	C IF RJB>1000 IT FINDS TRUE RJB THROUGH NOTE NUMB.
55300	66	IF(EDX.EQ.0.OR.I1.EQ.IP)GO TO 5541
55400		RJJB=RJB
55500		JJA=JA
55600		IF(JA.NE.16.OR.RJI.EQ.0)GO TO 160
55700	CC360	RJI=0
55800		RJB=RN(IFIX(PWDS(X22-1))+2)+39.6*RSTJC*RJE
55900	C  PUTS 13TH(+) LETTER TIN RIGHT POS. AFTER HORIZ. MOVE.
56000	160	IF(JA.EQ.1.AND.RJH.EQ.0)RJH=999.
56100	C  999=0 FOR STEM EXTENSIONS.
56200		CNT=1
56300		DO 5543 K=1,9
56400	C  10/6/73 ABOVE WAS ,11
56500		RA=RJQ(K)
56600		IF(RA.NE.0)CNT=K
56700	5543	RJJ(K)=RA
56800	C  USES ONLY 10 PARAMETERS BEYOND JA, JB
56900	2554	IF(PLT.NE.0)GO TO 5541
57000		IF(JA.EQ.9)CALL HOMER
57100		IF(JA.NE.6)GO TO 1261
57200		IF(JF.NE.0)RJM=-1
57300	
57400	1261	IF(RJM.NE.0)CALL HOMER
57500	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
57600	C **** FOR '0' EDITS ******
57700	261	RN(I)=CNT
57800		RN(I+1)=JA
57900		I=I+2
58000		RN(I)=RJB
58100		IF(RD.NE.0)RN(I)=RD
58200	C TO SAVE NOTE NUMBS IN P2.
58300		DO 4554 K=1,CNT
58400	4554	RN(I+K)=RJQ(K)
58500	3554	I=CNT+1+I
58600	C  WHAT ABOUT EDITS?*******
58700	5541	POS=STFF(JC+4)
58800		JB=RHORZ(RJB)
58900	C  LINE IS DIVIDED INTO 200 POINTS.
59000		CENTR=POS
59100	551	IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
59200		IF(JA.EQ.7)GO TO 81
59300		IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
59400		IF(JA.EQ.18)GO TO 80
59500		IF(JA.NE.88)GO TO 116
59600		IF(RJB.EQ.0)RJB=1
59700	C  USE ONLY ONE 88 CHANGE PER STAFF!!!! ********
59800		RSTFAC(JC+4)=RJB
59900	C   88,FAC,STF   SETS STAFF SIZE FACTOR(ALSO CAN BE DONE WITH 10)
60000		GO TO 57
60100	116	IF(JA.NE.16.AND.JA.NE.20)GO TO 120
60200		CALL ALPHA
60300		GO TO 57
60400	
60500	81	CALL KSIG
60600		GO TO 57
60700	
60800	80	CALL METER
60900		GO TO 57
61000	
61100	61	CALL HOMER
61200		GO TO 8853
61300	
61400	25	CALL ITMSUB
61500	C   BAR LINES, BEAMS, STAFF LINES ****
61600		GO TO 57
61700	
61800	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
61900	120	IF(I.NE.1.AND.I2.NE.IM)GO TO 5505
62000	C  'GM'=GET MORE
62100		TYPE 21
62200		ACCEPT FA5,NAME
62300		IF(NAME.EQ.'99')GO TO 5505
62400		IF(NAME.NE.IBL.AND.LOOKD(NAME).EQ.0)GO TO 120
62500	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
62600	3005	REWIND 21
62700	C  GUARDS AGAINST LOSSAGE!
62800		PLOTIT=-1
62900		IF(I1.NE.'G')PLOTIT=-2
63000	2005	IF(NAME.EQ.IBL)GO TO 2200
63100		CALL IFILE(21,NAME)
63200	C  JUMP TO READ BIG FILES
63300	2200	J=ITEM+1
63400	2202	READ(21,END=2207),X,Y,
63500		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
63600		1 LCNT,(LIST(K),K=1,LCNT)
63700	CC PUT IN NEXT YEAR(12/73)1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
63800	2207	IF(Y.EQ.0)GO TO 2205
63900		ITEM=ITEM+X
64000		IF(I2.EQ.IM)GO TO 2203
64100		I=Y
64200		READ(21,END=8851),RSTFAC,STFF
64300		IF(I1.EQ.IP)GO TO 6531
64400		READ(21,END=8851),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
64500		CALL DPYNEW
64600		GO TO 5505
64700	2205	TYPE 2206
64800		CALL EXIT
64900	2206	FORMAT(' **** UNPACK IT! ****')
65000	
65100	2203	RA=I-1
65200		DO 2204 K=J,J+X
65300	2204	PWDS(K)=PWDS(K)+RA
65400		GO TO 85
65500	121	IF(PLOTIT.EQ.0)GO TO 5504
65600	5121	CALL PLTSRT
65700	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
65800		PLT=-1-JH
65900	C  (JH) P8=1 OR 2 FOR 2-PASS PLOTS
66000		M=I
66100		I=I+M-1
66200		IF(RJB.EQ.0)RJB=1.
66300		DIS=RJB*1.24
66400		IF(RJC.EQ.0)RJC=RJB
66500		RHT=RJC*1.2
66600	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
66700		BOT=-BOT*RHT
66800		IF(TOP2.EQ.-999)GO TO 8121
66900		BOT=BOT+TOP2
67000		GO TO 9121
67100	8121	CALL PLOTS(K)
67200		RXGP=995.-BOT
67300	9121	NOMOVE=RJF+RJG*148.*RJC
67400	C  RJF=1 FOR NO MOVE AT END.  RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
67500		IXGP=JD
67600	C (JD) P4=1 FOR XGP OUTPUT
67700		IF(JE.NE.0)GO TO 1122
67800		IF(RJD.EQ.0)GO TO 6121
67900		IF(TOP2.NE.-999)RXGP=RXGP-BOT
68000	C  MOVES 0 POINT OVER EACH TIME.
68100		GO TO 1122
68200	6121	CALL PLOT(0,BOT,-3)
68300	C  MOVES PLOTTER UP IF P5=0.
68400	1122	X22=IXGP
68500	
68600	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
68700	6120	IF(M.GE.I)GO TO 7120
68800		CNT=RN(M)
68900	C  CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
69000		DO 6220 K=CNT+1,10
69100		JQ(K)=0
69200	6220	RJQ(K)=0
69300		JA=RN(M+1)
69400		M=M+2
69500		RJB=RN(M)
69600		DO 9120 K=1,CNT
69700		RJQ(K)=RN(M+K)
69800	9120	JQ(K)=RJQ(K)
69900		M=CNT+M+1
70000		IF(EDX.LE.0)GO TO 60
70100		GO TO 5505
70200	
70300	7120	M=1
70400		IF(EDX)GO TO 71201
70500		IF(PLT.EQ.1)EDX=-1
70600		PLT=0
70700	C  RETURNS FOR 'SL'=SAVE LAST
70800		GO TO 5505
70900	71201	X=50*RHT
71000		TOP=TOP*RHT+X
71100		IF(NOMOVE.NE.0)TOP=0
71200		IF(NOMOVE.GT.1)TOP=NOMOVE
71300		IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
71400		TOP2=TOP
71500		GO TO 2
71600	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
71700	CC7121	CALL PLOT(0,TOP,3)
71800	C  MOVES PLOTTER UP
71900	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
72000	CC	TOP2=TOP
72100	CC	GO TO 2
72200	
72300	56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I/)
72400	1	FORMAT(I,24F)
72500	21	FORMAT(' FILE NAME?  '$)
72600		END